home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / Form3.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-05  |  12.8 KB  |  408 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         Form3.lsp
  5. ; RCS:          $Header: Form3.lsp,v 1.4 91/10/05 03:03:26 mayer Exp $
  6. ; Description:  Example options panel for Bob Leichner's audio controller...
  7. ; Author:       Niels Mayer, HPLabs
  8. ; Created:      Fri Jul 27 14:00:53 1990
  9. ; Modified:     Sat Oct  5 03:02:44 1991 (Niels Mayer) mayer@hplnpm
  10. ; Language:     Lisp
  11. ; Package:      N/A
  12. ; Status:       X11r5 contrib tape release
  13. ;
  14. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. ;
  17. ; Permission to use, copy, modify, distribute, and sell this software and its
  18. ; documentation for any purpose is hereby granted without fee, provided that
  19. ; the above copyright notice appear in all copies and that both that
  20. ; copyright notice and this permission notice appear in supporting
  21. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  22. ; used in advertising or publicity pertaining to distribution of the software
  23. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  24. ; makes no representations about the suitability of this software for any
  25. ; purpose.  It is provided "as is" without express or implied warranty.
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27.  
  28. (let (
  29.       form_w sliderpnl_w btnpnl_w
  30.       balance_w volume_w bass_w treble_w
  31.       pb1_w pb2_w pb3_w pb4_w pb5_w ok_w         
  32.       )
  33.  
  34.  
  35. (if (not (and (eq *MOTIF_VERSION* 1) (eq *MOTIF_REVISION* 0)))
  36.  
  37. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  38. ;;; Code for Motif 1.1 (and later) version -- 1.0 version below has
  39. ;;; workarounds for bugs in Motif 1.0 XmForm widget.
  40. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41.     (progn    
  42.  
  43.       ;; Note use of a dummy toplevel widget (*TOPLEVEL_WIDGET*) below
  44.       (setq form_w
  45.         (send XM_FORM_WIDGET_CLASS :new :dialog "form" *TOPLEVEL_WIDGET*
  46.           :XMN_DIALOG_TITLE        "Audio Controller Options"
  47.           :XMN_AUTO_UNMANAGE        nil ;BulletinBoard resource -- setting to NIL prevents automatic unamange of dialog caused by clicking on pushbutton child of form_w....
  48.           ))
  49.       (setq sliderpnl_w
  50.         (send XM_FORM_WIDGET_CLASS :new :managed "sliders" form_w
  51.           :XMN_LEFT_ATTACHMENT        :attach_form
  52.           :XMN_BOTTOM_ATTACHMENT    :attach_form
  53.           :XMN_TOP_ATTACHMENT        :attach_form
  54.           ))
  55.       (setq btnpnl_w
  56.         (send XM_ROW_COLUMN_WIDGET_CLASS :new :managed "buttons" form_w
  57.           :XMN_ORIENTATION        :vertical
  58.           :XMN_ENTRY_ALIGNMENT        :alignment_center
  59.           :XMN_IS_ALIGNED        t
  60.           :XMN_PACKING            :pack_tight
  61.           :XMN_TOP_ATTACHMENT        :attach_form
  62.           :XMN_BOTTOM_ATTACHMENT    :attach_form
  63.           :XMN_LEFT_ATTACHMENT        :attach_widget
  64.           :XMN_LEFT_WIDGET        sliderpnl_w
  65.           :XMN_RIGHT_ATTACHMENT        :attach_form
  66.           ))
  67.       ;;
  68.       ;; place a balance slider at bottom, horizontally stretching from
  69.       ;; left side of form to the right side of the treble control
  70.       ;; 
  71.       (setq balance_w 
  72.         (send XM_SCALE_WIDGET_CLASS :new :managed "balance" sliderpnl_w
  73.           :XMN_TITLE_STRING        "Balance"
  74.           :XMN_SENSITIVE        t
  75.           :XMN_SHOW_VALUE        t
  76.           :XMN_ORIENTATION        :horizontal
  77.           :XMN_PROCESSING_DIRECTION    :max_on_right
  78.           :XMN_MAXIMUM            10
  79.           :XMN_MINIMUM            -10
  80.           :XMN_LEFT_ATTACHMENT        :attach_form
  81.           :XMN_BOTTOM_ATTACHMENT    :attach_form
  82.           :XMN_RIGHT_ATTACHMENT        :attach_form
  83.           ))
  84.       ;;
  85.       ;; Create volume, bass, and treble sliders stretching across form
  86.       ;; horizontally...
  87.       ;;
  88.       (setq volume_w 
  89.         (send XM_SCALE_WIDGET_CLASS :new :managed "volume" sliderpnl_w
  90.           :XMN_TITLE_STRING        "Vol"
  91.           :XMN_SENSITIVE        t
  92.           :XMN_SHOW_VALUE        t
  93.           :XMN_ORIENTATION        :vertical
  94.           :XMN_PROCESSING_DIRECTION    :max_on_top
  95.           :XMN_MAXIMUM            100
  96.           :XMN_MINIMUM            0
  97.           :XMN_TOP_ATTACHMENT        :attach_form
  98.           :XMN_LEFT_ATTACHMENT        :attach_form
  99.           :XMN_BOTTOM_ATTACHMENT    :attach_widget
  100.           :XMN_BOTTOM_WIDGET        balance_w
  101.           ))
  102.       (setq bass_w 
  103.         (send XM_SCALE_WIDGET_CLASS :new :managed "bass" sliderpnl_w
  104.           :XMN_TITLE_STRING        "Bass"
  105.           :XMN_SENSITIVE        t
  106.           :XMN_SHOW_VALUE        t
  107.           :XMN_ORIENTATION        :vertical
  108.           :XMN_PROCESSING_DIRECTION    :max_on_top
  109.           :XMN_MAXIMUM            10
  110.           :XMN_MINIMUM            -10
  111.           :XMN_TOP_ATTACHMENT        :attach_form
  112.           :XMN_LEFT_ATTACHMENT        :attach_widget
  113.           :XMN_LEFT_WIDGET        volume_w
  114.           :XMN_BOTTOM_ATTACHMENT    :attach_widget
  115.           :XMN_BOTTOM_WIDGET        balance_w
  116.           ))
  117.       (setq treble_w 
  118.         (send XM_SCALE_WIDGET_CLASS :new :managed "treble" sliderpnl_w
  119.           :XMN_TITLE_STRING        "Treble"
  120.           :XMN_SENSITIVE        t
  121.           :XMN_SHOW_VALUE        t
  122.           :XMN_ORIENTATION        :vertical
  123.           :XMN_PROCESSING_DIRECTION    :max_on_top
  124.           :XMN_MAXIMUM            10
  125.           :XMN_MINIMUM            -10
  126.           :XMN_TOP_ATTACHMENT        :attach_form
  127.           :XMN_LEFT_ATTACHMENT        :attach_widget
  128.           :XMN_LEFT_WIDGET        bass_w
  129.           :XMN_BOTTOM_ATTACHMENT    :attach_widget
  130.           :XMN_BOTTOM_WIDGET        balance_w
  131.           ))
  132.  
  133.       ;;
  134.       ;; place a column of buttons vertically on rhs of form in btnpnl
  135.       ;;
  136.       (setq pb1_w
  137.         (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed "pb1" btnpnl_w
  138.           :XMN_LABEL_STRING    "Jack In"
  139.           ))
  140.       (setq pb2_w
  141.         (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed "pb2" btnpnl_w
  142.           :XMN_LABEL_STRING    "Jack Out"
  143.           ))
  144.       (setq pb3_w
  145.         (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed "pb3" btnpnl_w
  146.           :XMN_LABEL_STRING    "Do Watoosi"
  147.           ))
  148.       (setq pb4_w
  149.         (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed "pb4" btnpnl_w
  150.           :XMN_LABEL_STRING    "Enter Hyperspace"
  151.           ))
  152.       (setq pb5_w
  153.         (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed "pb5" btnpnl_w
  154.           :XMN_LABEL_STRING    "Winterp-Mute"
  155.           ))
  156.       (setq ok_w
  157.         (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed "ok" btnpnl_w
  158.           :XMN_LABEL_STRING    "Ok"
  159.           :xmn_show_as_default t
  160.           ))
  161.  
  162.       ;;
  163.       ;; this causes the ok button to be pressed when <return> is entered within the form widget.
  164.       ;;
  165.       (send form_w :set_values :xmn_default_button ok_w)
  166.  
  167.       (send form_w :manage)        ;pop it up
  168.  
  169.       )
  170.  
  171. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  172. ;;; The Motif 1.0 version -- workarounds for bugs in Motif 1.0 XmForm
  173. ;;; widget.
  174. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  175.   (progn
  176.   
  177.     ;; Note use of a dummy toplevel widget (*TOPLEVEL_WIDGET*) below
  178.     (setq form_w
  179.       (send XM_FORM_WIDGET_CLASS :new :dialog "form" *TOPLEVEL_WIDGET*
  180.         :XMN_DIALOG_TITLE "Audio Controller Options"
  181.         :XMN_AUTO_UNMANAGE nil    ;BulletinBoard resource -- setting to NIL prevents automatic unamange of dialog caused by clicking on pushbutton child of form_w....
  182.         ))
  183.  
  184.     ;;
  185.     ;; Create volume, bass, and treble sliders stretching across form horizontally...
  186.     ;;
  187.  
  188.     (setq volume_w 
  189.       (send XM_SCALE_WIDGET_CLASS :new :managed "volume" form_w
  190.         :XMN_TITLE_STRING        "Vol"
  191.         :XMN_SENSITIVE            t
  192.         :XMN_SHOW_VALUE            t
  193.         :XMN_ORIENTATION        :vertical
  194.         :XMN_PROCESSING_DIRECTION    :max_on_top
  195.         :XMN_MAXIMUM            100
  196.         :XMN_MINIMUM            0
  197.         :XMN_TOP_ATTACHMENT        :attach_form
  198.         :XMN_LEFT_ATTACHMENT        :attach_form
  199.         ))
  200.     (setq bass_w 
  201.       (send XM_SCALE_WIDGET_CLASS :new :managed "bass" form_w
  202.         :XMN_TITLE_STRING        "Bass"
  203.         :XMN_SENSITIVE            t
  204.         :XMN_SHOW_VALUE            t
  205.         :XMN_ORIENTATION        :vertical
  206.         :XMN_PROCESSING_DIRECTION    :max_on_top
  207.         :XMN_MAXIMUM            11
  208.         :XMN_MINIMUM            -10
  209.         :XMN_TOP_ATTACHMENT        :attach_form
  210.         :XMN_LEFT_ATTACHMENT        :attach_widget
  211.         :XMN_LEFT_WIDGET        volume_w
  212.         ))
  213.     (setq treble_w 
  214.       (send XM_SCALE_WIDGET_CLASS :new :managed "treble" form_w
  215.         :XMN_TITLE_STRING        "Treble"
  216.         :XMN_SENSITIVE            t
  217.         :XMN_SHOW_VALUE            t
  218.         :XMN_ORIENTATION        :vertical
  219.         :XMN_PROCESSING_DIRECTION    :max_on_top
  220.         :XMN_MAXIMUM            11
  221.         :XMN_MINIMUM            -10
  222.         :XMN_TOP_ATTACHMENT        :attach_form
  223.         :XMN_LEFT_ATTACHMENT        :attach_widget
  224.         :XMN_LEFT_WIDGET        bass_w
  225.         ))
  226.  
  227.     ;;
  228.     ;; place a column of buttons vertically on rhs of form
  229.     ;;
  230.  
  231.     (setq pb1_w
  232.       (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed "pb1" form_w
  233.         :XMN_LABEL_STRING    "Jack In"
  234.         :XMN_TOP_ATTACHMENT    :attach_form
  235.         :XMN_LEFT_ATTACHMENT    :attach_widget
  236.         :XMN_LEFT_WIDGET    treble_w
  237. ;;;        :XMN_RIGHT_ATTACHMENT    :attach_form
  238.         ))
  239.     (setq pb2_w
  240.       (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed "pb2" form_w
  241.         :XMN_LABEL_STRING    "Jack Out"
  242.         :XMN_TOP_ATTACHMENT    :attach_widget
  243.         :XMN_TOP_WIDGET        pb1_w
  244.         :XMN_LEFT_ATTACHMENT    :attach_widget
  245.         :XMN_LEFT_WIDGET    treble_w
  246. ;;;        :XMN_RIGHT_ATTACHMENT    :attach_form
  247.         ))
  248.     (setq pb3_w
  249.       (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed "pb3" form_w
  250.         :XMN_LABEL_STRING    "Do Watoosi"
  251.         :XMN_TOP_ATTACHMENT    :attach_widget
  252.         :XMN_TOP_WIDGET        pb2_w
  253.         :XMN_LEFT_ATTACHMENT    :attach_widget
  254.         :XMN_LEFT_WIDGET    treble_w
  255. ;;;        :XMN_RIGHT_ATTACHMENT    :attach_form
  256.         ))
  257.     (setq pb4_w
  258.       (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed "pb4" form_w
  259.         :XMN_LABEL_STRING    "Enter Hyperspace"
  260.         :XMN_TOP_ATTACHMENT    :attach_widget
  261.         :XMN_TOP_WIDGET        pb3_w
  262.         :XMN_LEFT_ATTACHMENT    :attach_widget
  263.         :XMN_LEFT_WIDGET    treble_w
  264. ;;;        :XMN_RIGHT_ATTACHMENT    :attach_form
  265.         ))
  266.     (setq pb5_w
  267.       (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed "pb5" form_w
  268.         :XMN_LABEL_STRING    "Winterp-Mute"
  269.         :XMN_TOP_ATTACHMENT    :attach_widget
  270.         :XMN_TOP_WIDGET        pb4_w
  271.         :XMN_LEFT_ATTACHMENT    :attach_widget
  272.         :XMN_LEFT_WIDGET    treble_w
  273. ;;;        :XMN_RIGHT_ATTACHMENT    :attach_form
  274.         ))
  275.     (setq ok_w
  276.       (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed "ok" form_w
  277.         :XMN_LABEL_STRING    "Ok"
  278.         :XMN_SHOW_AS_DEFAULT    2
  279.         :XMN_TOP_ATTACHMENT    :attach_widget
  280.         :XMN_TOP_WIDGET        pb5_w
  281.         :XMN_LEFT_ATTACHMENT    :attach_widget
  282.         :XMN_LEFT_WIDGET    treble_w
  283. ;;;        :XMN_RIGHT_ATTACHMENT    :attach_form
  284.         ))
  285.  
  286.     ;;
  287.     ;; place a balance slider horizontally stretching from left side of form to the
  288.     ;; right side of the treble control
  289.     ;; 
  290.  
  291.     (setq balance_w 
  292.       (send XM_SCALE_WIDGET_CLASS :new :managed "balance" form_w
  293.         :XMN_TITLE_STRING        "Balance"
  294.         :XMN_SENSITIVE            t
  295.         :XMN_SHOW_VALUE            t
  296.         :XMN_ORIENTATION        :horizontal
  297.         :XMN_PROCESSING_DIRECTION    :max_on_right
  298.         :XMN_MAXIMUM            10
  299.         :XMN_MINIMUM            -11
  300.         :XMN_TOP_ATTACHMENT        :attach_widget
  301.         :XMN_TOP_WIDGET            treble_w
  302.         :XMN_LEFT_ATTACHMENT        :attach_form
  303.         :XMN_RIGHT_ATTACHMENT        :attach_opposite_widget
  304.         :XMN_RIGHT_WIDGET        treble_w
  305.         :XMN_BOTTOM_ATTACHMENT        :attach_opposite_widget
  306.         :XMN_BOTTOM_WIDGET        ok_w
  307.         ))
  308.  
  309.     ;;
  310.     ;; this causes the ok button to be pressed when <return> is entered within the form widget.
  311.     ;;
  312.     (send form_w :set_values :xmn_default_button ok_w)
  313.  
  314.     ;;
  315.     ;; work around a resize bug for Motif 1.0 only: if these constraint resources are set before the
  316.     ;; form-dialog widget is managed, then the dialog shell comes up too small
  317.     ;; and doesn't display the buttons. If no right attachment is made, then all
  318.     ;; the buttons come up in different sizes which looks ugly.
  319.     ;;
  320.  
  321.     ;;
  322.     ;; this pops up the form-dialog...
  323.     ;;
  324.     (send form_w :manage)        ;pop it up
  325.  
  326.     (send pb1_w :set_values
  327.       :XMN_RIGHT_ATTACHMENT :attach_form
  328.       )
  329.     (send pb2_w :set_values 
  330.       :XMN_RIGHT_ATTACHMENT :attach_form
  331.       )
  332.     (send pb3_w :set_values
  333.       :XMN_RIGHT_ATTACHMENT :attach_form
  334.       )
  335.     (send pb4_w :set_values
  336.       :XMN_RIGHT_ATTACHMENT :attach_form
  337.       )
  338.     (send pb5_w :set_values
  339.       :XMN_RIGHT_ATTACHMENT :attach_form
  340.       )
  341.     (send  ok_w :set_values
  342.        :XMN_RIGHT_ATTACHMENT :attach_form
  343.        )
  344.     )
  345.   )
  346.  
  347. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  348. ;;
  349. ;; Set up callbacks... (shared between 1.0 and 1.1 versions)
  350. ;;
  351.  
  352. (send pb1_w :set_callback :xmn_activate_callback '(CALLBACK_WIDGET)
  353.       '(
  354.     (format T "callback called on button: ~A\n"
  355.         (xm_string_get_l_to_r
  356.          (car (send CALLBACK_WIDGET :get_values :xmn_label_string nil))))
  357.     ))
  358.  
  359. (send pb2_w :set_callback :xmn_activate_callback '(CALLBACK_WIDGET)
  360.       '(
  361.     (format T "callback called on button: ~A\n"
  362.         (xm_string_get_l_to_r
  363.          (car (send CALLBACK_WIDGET :get_values :xmn_label_string nil))))
  364.     ))
  365.  
  366. (send pb3_w :set_callback :xmn_activate_callback '(CALLBACK_WIDGET)
  367.       '(
  368.     (format T "callback called on button: ~A\n"
  369.         (xm_string_get_l_to_r
  370.          (car (send CALLBACK_WIDGET :get_values :xmn_label_string nil))))
  371.     ))
  372.  
  373. (send pb4_w :set_callback :xmn_activate_callback '(CALLBACK_WIDGET)
  374.       '(
  375.     (format T "callback called on button: ~A\n"
  376.         (xm_string_get_l_to_r
  377.          (car (send CALLBACK_WIDGET :get_values :xmn_label_string nil))))
  378.     ))
  379.  
  380. (send pb5_w :set_callback :xmn_activate_callback '(CALLBACK_WIDGET)
  381.       '(
  382.     (format T "callback called on button: ~A\n"
  383.         (xm_string_get_l_to_r
  384.          (car (send CALLBACK_WIDGET :get_values :xmn_label_string nil))))
  385.     ))
  386.  
  387. ;;
  388. ;; unmanage the form dialog when the ok button is pressed --> pops down.
  389. ;; after unmanaging, read values of sliders....
  390. ;;
  391. (send ok_w :set_callback :xmn_activate_callback '()
  392.       '(
  393.     (send form_w :unmanage)
  394.     (format T "Volume=~A; Bass=~A; Treble=~A; Balance=~A\n"
  395.         (send volume_w :get_value)
  396.         (send bass_w :get_value)
  397.         (send treble_w :get_value)
  398.         (send balance_w :get_value)
  399.         )
  400.     ))
  401.  
  402. (defun popup-audio-options-panel ()
  403.   (send form_w :manage)
  404.   )
  405.  
  406.  
  407. )
  408.